home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Programming / Programming Utilities / ViewIt 2.04 ƒ / ViewIt™ 2.04 Shareware / Projects / Fortran Demos / fDemoLF.f < prev    next >
Encoding:
Text File  |  1992-08-12  |  3.3 KB  |  127 lines  |  [TEXT/ttxt]
  1. C NOTE: Read the "MPW Fortrans" section of "About Compilers"
  2. C before compiling LF programs that use FaceWare modules.
  3.  
  4. C FaceIt 2.04 Demonstration Program
  5. C ©FaceWare 1989-92.  All Rights Reserved.
  6. C1 - run program to see on-line comments
  7.  
  8. !!M Inlines.f
  9. C2
  10. !!I FaceProcLF.inc
  11.  
  12.       PROGRAM fDemoLF
  13.     implicit none
  14. C NOTE: If you use the "!!G" directive for precompiled globals, add
  15. C our FaceStorLF.inc globals to yours and then remove following line
  16.     include 'FaceStorLF.inc'
  17.       record /FaceRec/ fRec
  18.       common/FaceStuff/fRec
  19.     integer*1 keys(16)
  20.     integer*2 i,mode
  21.     integer*4 oldCount,newCount
  22.     character*256 fileName
  23. C3
  24.       fRec.uName = 'fDemo.Rsrc'
  25. C4,5
  26.       call FaceIt(0,DoInit,515,0,0,0)
  27. C6
  28.     call FaceIt(0,NewWnd,1030,1,0,0)
  29. C7
  30.       do while (.true.)
  31.         call FaceIt(0,DoLoop,0,0,0,0)
  32. C8
  33.         if (fRec.uMenuID = 101) then
  34. C9
  35.         if (fRec.uMenuItem = 1) then
  36.           fRec.uString = 'Demonstration of the use of FaceIt'
  37.      +//char(13)//'to support program-wide features.'
  38.           call FaceIt(0,ShoStr,3,12,(1 + (409*65536)),0)
  39.         end if
  40. C10
  41.       else if ((fRec.uMenuID >= 105).and.(fRec.uMenuID <= 107)) then
  42. C11
  43.         if (fRec.uMenuItem = 1) then
  44.           call SysBeep(%val(int2(5)))
  45.         else if (fRec.uMenuItem = 2) then
  46.           call SysBeep(%val(int2(5)))
  47.           call SysBeep(%val(int2(5)))
  48.         else if (fRec.uMenuItem = 3) then
  49.           call SysBeep(%val(int2(5)))
  50.           call SysBeep(%val(int2(5)))
  51.           call SysBeep(%val(int2(5)))
  52. C12
  53.         else if (fRec.uMenuItem = 8) then
  54. C13
  55.         call FaceIt(0,ShoAlt,1010,0,1,1)
  56.         mode = fRec.uResult
  57.         oldCount = 0
  58.         if (mode > 1) then
  59.           do while (.true.)
  60. C14
  61.             newCount = TickCount
  62.             if (newCount - oldCount > 180) then
  63.               call SysBeep(%val(int2(5)))
  64.             oldCount = newCount
  65.             end if
  66. C15
  67.             if (mode = 2) then
  68.               if (GetNextEvent(%val(int2(-1)),fRec.fEvent) <> 0) then
  69.               if ((fRec.fEvent(1) = 6).or.(fRec.fEvent(1) = 15)) then
  70.                 call FaceIt(0,DoEvnt,0,0,0,0)
  71.               else if (fRec.fEvent(1) = 5) then
  72.                 leave
  73.               end if
  74.             end if
  75.             end if
  76. C16
  77.             if (mode = 3) then
  78.               call GetKeys(keys)
  79.             if ((BitTst(keys,%val(61))<>0).and.(BitTst(keys,%val(48))<>0)) then
  80.               call FlushEvents(%val(int2(62)),%val(int2(0)))
  81.               leave
  82.             end if
  83.             end if
  84.           end do
  85.         end if
  86.         end if
  87. C17
  88.       else if (fRec.uMenuID = 1030) then
  89.         if (fRec.wcHit > 3) then
  90.           call FaceIt(0,GetCtl,1030,0,1,4)
  91.           call FaceIt(0,PopMen,107,fRec.cRect(1)-5,fRec.cRect(2)-11,0)
  92.         fRec.wcHit = fRec.uMenuItem
  93.         end if
  94.         if (fRec.wcHit > 0) then
  95.           do i = 1,fRec.wcHit
  96.           call SysBeep(%val(int2(5)))
  97.         end do
  98.         end if
  99. C18
  100.       else if (fRec.uMenuID = 1100) then
  101.         if (fRec.uMenuItem = 2) then
  102.           if (fRec.fActiveWnd = 0) then
  103.           fRec.uString = 'No Window'
  104.         else if (fRec.fActiveID <> 1200) then
  105.           fRec.uString = 'Non-ViewIt Window'
  106.         else if (fRec.fActiveResID = 1010) then
  107.           fRec.uString = 'Editor Window'
  108.         else if (fRec.fActiveResID = 1020) then
  109.           fRec.uString = 'Clipboard Window'
  110.         else if (fRec.fActiveResID = 1030) then
  111.           fRec.uString = 'Beeps Window'
  112.         end if
  113.         call FaceIt(0,SetItm2,105,10,3,0)
  114. C19
  115.         else if (fRec.uMenuItem = 512) then
  116.           if ((fRec.uString = 'TEXT').and.(fRec.uResult = 1)) then
  117.           fileName = fRec.uName
  118.           call FaceIt(0,GetCtl,1010,0,1,1)
  119.           fRec.uName = fileName
  120.           call FaceIt(fRec.cControl,1551,0,1,0,0) !OpnCTxt
  121.         end if
  122.         end if
  123.       end if
  124.       end do
  125.  
  126.       end
  127.